10 REM RBBS VERSION 2.2
20 REM *****RBBS - "Remote Bulletin Board System"*****
30 REM by Bruce R. Ratoff
40 REM adapted from Xitan Basic SJBBS by Howard Moulton
45 REM changes of 12/10/80 by Bruce Ratoff
46 REM    FIXED BUG THAT PREVENTED "NEWCOM" FROM PRINTING
47 REM    MADE "LASTCALR" A $SYS FILE
48 REM    IMPROVED CONTROL-K RESPONSE (STILL NOT PERFECT BUT BETTER)
50 REM changes of 11/14/80 by Ron Fowler
60 REM    ADDED PERSONAL MESSAGE FUNCTION
70 REM    K FUNCTION STORES NAME OF ERASING USER IN MSG# RECORD
80 REM changes of 11/9/80  by Ron Fowler
90 REM  1: PRINT CALLERS FOR SYSOP
100 REM  2: SAVE KILLED MSG #S, PUT PWD'S IN MSG FILE
110 REM  3: RE-ENTRY OPTION, FILE "LASTCALR"
120 REM 10/21/80 --> Fix several minor bugs in P and S cmds.  (BRR)
130 REM Changes 10/15/80 by Ron Fowler:
140 REM    1) added "Q", quick summary command
150 REM    2) added "X", "P" cmds - expert user mode, and bell toggle
160 REM    3) rearranged message entry for CBBS compatibility
170 REM    4) added ";" delimitation - "command anticipation"
180 REM    5) added password file access at 3 levels:
190 REM       a. p1$ is high-level quick-access to cp/m
200 REM       b. p2$ is sysop 'last name' (sysop has special priveliges)
210 REM       c. p3$ is the normal cpm access password:
220 REM          (IF P3$ IS "NOPASS", THEN CPM ACCESS IS UNRESTRICTED)
230 REM    6) coded several sequences as subroutines, to shorten code
240 REM    7) made several cosmetic changes
250 REM note: the file "PWDS" can be created by a text editor.  The
260 REM       passwords are sequential..e.g.,"GOTOCPM,FOWLER,NOPASS"
270 REM *** put the shortest version of your first name in line 920
280 REM
290 REM
300 DEFINT A-Z
310 VERS$="vers 2.2"' VERSION NUMBER
320 DIM A$(17),M(200,2)
330 POKE 0,&HCD
340 INC=1
350 ON ERROR GOTO 13620
360 RFLG=PEEK(&H5D):POKE &H5D,32
370 REM
380 REM SIGNON FUNCTIONS
390 REM
400 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
410 P2$="RON":P3$="SLAGBACK 'DEFAULT PWDS
420 BK=0:GOSUB 13020:N=1:A$="Westland, Mich. RBBS...":GOSUB 13020:N=0
430 OPEN "I",1,"A:PWDS":IF EOF(1) THEN 450
440 INPUT #1,P1$,P2$,P3$
450 CLOSE #1
460 BEL=-1:XPR=0'INITIAL BEL ON, NOT EXPERT
470 A$=VERS$:GOSUB 13020:GOSUB 13020
480 SAV$=""
490 IF RFLG<>ASC("P") THEN 530
500 INC=0
510 OPEN "I",1,"LASTCALR":INPUT #1,N$,O$:CLOSE
520 A$="Welcome back, "+N$+" "+O$+".":GOSUB 13020:GOSUB 13020:GOTO 740
530 GOSUB 4080:GOSUB 3080'REM PRINT INFO, THEN BULLETINS
540 BK=0:A$="(Prompting bell means system is ready for input).":GOSUB 13020:GOSUB 13020
550 A$="What is your FIRST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:N$=B$:

    IF N$="" THEN 550
560 IF N$=P1$ THEN 2240 ' DIRECT CPM EXIT
570 IF N$<"A" OR LEN(N$)=1 THEN 550
580 A1$="What is your LAST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:O$=B$:

    IF O$="" THEN 550
590 IF O$<"A" OR LEN(O$)=1 THEN 550
600 IF N$="SYSOP" AND O$=P2$ THEN O$="":GOTO 700
610 IF N$="SYSOP" THEN 550
620 A$="Checking user file...":GOSUB 13020:V=0:OPEN "R",1,"A:USERS",62:

    FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
630 FOR I=2 TO NU+1:GET#1,I:

    IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN MF$=LEFT$(RR$,1):CLOSE:

       GOSUB 13020:GOTO 700
640 NEXT I
650 V=1:A1$="Where (City,State) are you calling from ?":GOSUB 13020:

    C=1:GOSUB 13260:C=0:ST$=B$:IF ST$="" THEN 580
660 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 13020:

    A1$="Did I misspell anything ?":GOSUB 13020:C=1:GOSUB 13260:C=0:

    IF LEFT$(B$,1)="Y" THEN 550
670 A1$="This checking is only done the first time you call.":GOSUB 13020
680 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 16000:NU=NU+1:PUT#1,NU+1:

    S$=STR$(NU):GOSUB 16000:PUT#1,1:CLOSE
690 FIL$="NEWCOM":GOSUB 18000:MF$=" "
700 A$="Logging "+N$+" "+O$+" to disk...":N=1:GOSUB 13020:

    OPEN "R",1,"A:CALLERS",60:    FIELD#1,60 AS RR$:GET#1,1
710 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 16000:PUT#1,1:RE=RE+1
720 S$=N$+" "+O$+" "+ST$:GOSUB 16000:PUT#1,RE:CLOSE#1
730 OPEN "O",1,"LASTCALR. "+CHR$(&HA0):PRINT #1,N$;",";O$:CLOSE
740 BK=0:GOSUB 13020:A$="Active # of msg's ":N=1:GOSUB 13020:

    OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
750 A$=STR$(M)+".":GOSUB 13020
760 A$="You are caller # ":N=1:GOSUB 13020:GET#1,CALLS
770 CN=VAL(RR$)+INC:A$=STR$(CN):LSET RR$=A$:GOSUB 13020:PUT#1,CALLS
780 A$="Next msg # will be ":N=1:GOSUB 13020:GET#1,MNUM:U=VAL(RR$)
790 A$=STR$(U+1):GOSUB 13020:CLOSE:GOSUB 13020
800 REM
810 REM LOOK FOR MSGS FOR THIS CALLER
820 REM AND BUILD MESSAGE INDEX
830 REM
840 FT=1:MX=0:MZ=0:IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
850 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
860 BK=0:GET#1,RE:IF EOF(1) THEN 960
870 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 950
880 IF IU=0 THEN IU=G
890 IF G>9998 THEN MZ=MZ-1:GOTO 960
900 GET#1,RE+3:GOSUB 16500:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 930
910 IF N$<>"SYSOP" THEN 950
920 IF INSTR(S$,"RON")=0 THEN 950
930 IF FT THEN A$="Please retrieve and kill the following message(s) left for you:":GOSUB 13020:FT=0
940 A$=STR$(G):N=1:GOSUB 13020
950 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 860
960 CLOSE:GOSUB 13020:GOSUB 13020
1000 REM
1020 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
1040 REM
1060 A1$="Function":IF NOT XPR THEN A1$=A1$+" (B,E,R,S,K,G,W,C,U,P,X,Q (or '?' if not known)"
1080 A1$=A1$+"?":GOSUB 13020:C=1:GOSUB 13260:C=0
1100 IF B$="" THEN 1000
1120 FF=INSTR("BER?SKGWCUPXQL",B$):GOSUB 1140:GOTO 1000
1140 IF FF=0 THEN 1180
1160 ON FF GOTO 3000,6000,8000,5000,18060,11000,10000,4000,2000,12000,

     17040,17000,18080,19000
1180 IF N$+O$="SYSOP" THEN IF B$="%" THEN GOSUB 19000:GOTO 1000
1200 A$="I don't understand '"+B$+"', "+N$+".":GOSUB 13020:GOSUB 13020:

     SAV$="":RETURN
2000 REM
2020 REM ***EXIT TO CP/M***
2040 REM
2060 IF MF$="*" THEN A$="You've lost that privelege, "+N$:GOSUB 13020:

     SAV$="":RETURN
2080 IF P3$="NOPASS" THEN 2140
2100 A1$="Password ?":GOSUB 13020:C=1:GOSUB 13260:C=0
2120 IF B$<>P3$ THEN A$="+++INVALID+++":GOSUB 13020:GOSUB 13020:RETURN
2140 IF XPR THEN 2240
2160 A$="Please remember to type BYE before hanging up the phone.":GOSUB 13020:GOSUB 13020
2180 A$="To re-enter RIBBS, type:":GOSUB 13020:

   A$="A>RIBBS P":GOSUB 13020:GOSUB 13020
2200 A$="For info on software exchange, type:":GOSUB 13020:

     A$="A>TYPE THIS-SYS.DOC":GOSUB 13020:GOSUB 13020
2220 A$="For general info, type:":GOSUB 13020:

     A$="A>HELP":GOSUB 13020:GOSUB 13020
2240 GOSUB 13020:POKE 4,0:A$="Entering CP/M...":GOSUB 13020:POKE 0,&HC3:SYSTEM
3000 REM
3020 REM ***DISPLAY BULLETINS***
3040 REM
3060 GOSUB 12220
3080 FIL$="BULLETIN":GOSUB 18000:RETURN
4000 REM
4020 REM ***DISPLAY WELCOME MESSAGE***
4040 REM
4060 GOSUB 12220
4080 FIL$="INFO":GOSUB 18000:RETURN
5000 REM
5020 REM *** DISPLAY MENU OF FUNCTIONS ***
5040 REM
5060 GOSUB 13020:A$="Functions supported:":GOSUB 13020:IF BK THEN RETURN
5080 A$="S--> Scan messages     R--> Retrieve message":GOSUB 13020:

     IF BK THEN RETURN
5100 A$="E--> Enter message     K--> Kill message":GOSUB 13020:IF BK THEN RETURN
5120 A$="B--> retype Bulletins  W--> retype welcome":GOSUB 13020:IF BK THEN RETURN
5140 A$="C--> exit to CP/M      U--> list User file":GOSUB 13020:IF BK THEN RETURN
5160 A$="P--> Prompt (bel) togl X--> eXpert user mode":GOSUB 13020:IF BK THEN RETURN
5180 A$="Q--> Quick summary     G--> Goodbye (signoff)":GOSUB 13020:IF BK THEN RETURN
5200 GOSUB 13020:A$="Commands may be strung together, separated by semicolons.":

     GOSUB 13020:A$="For example, 'R;123' retrieves message # 123.":GOSUB 13020:

     IF BK THEN RETURN
5220 GOSUB 13020:A$="Software exchange is done under CP/M using":GOSUB 13020:

     A$="the XMODEM program (for intelligent transfer)":GOSUB 13020:

     A$="or the TYPE command (simple ASCII listing).":GOSUB 13020
5240 IF BK THEN RETURN
5280 GOSUB 13020:RETURN
6000 REM
6020 REM ***ENTER A NEW MESSAGE***
6040 REM
6060 F=0:GOSUB 13020:OPEN "R",1,"A:COUNTERS",5:A$="Msg # will be ":N=1:

     GOSUB 13020:FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
6080 A$=STR$(V+1):GOSUB 13020:CLOSE
6100 GOSUB 13020:A1$="Todays date (MM/DD/YY)?":GOSUB 13020:GOSUB 13260:D$=B$
6120 A1$="Who to (C/R for ALL)?":GOSUB 13020:C=1:GOSUB 13260:C=0:IF B$="" THEN T$="ALL" ELSE T$=B$
6140 A1$="Subject?":GOSUB 13020:C=1:GOSUB 13260:C=0:K$=B$:

     A1$="Password?":GOSUB 13020:C=1:GOSUB 13260:C=0:PW$=B$
6160 A1$="To enter msg,type in lines.":GOSUB 13020:A1$="To edit,hit blank C/R."

     :GOSUB 13020:GOSUB 13020:F=0
6180 IF F=16 THEN A$="Msg full.":GOSUB 13020:GOTO 6240
6200 F=F+1:A1$=STR$(F)+" ":N=1:GOSUB 13020:GOSUB 13260:IF B$="" THEN F=F-1:GOTO 6240
6220 A$(F)=B$+" ":GOTO 6180
6240 GOSUB 13020:A1$="(L)ist, (E)dit, (Q)uit, (C)ontinue, (S)ave; Select?":

     IF XPR THEN A1$="L,E,Q,C,S?"
6260 GOSUB 13020:C=1:GOSUB 13260:C=0
6280 IF B$<>"L" THEN 6360 ELSE GOSUB 12220
6300 GOSUB 13020:FOR L=1 TO F:A$=STR$(L)+" "+A$(L)
6320 IF BK THEN 6240 ELSE GOSUB 13020:NEXT L
6340 GOSUB 13020:GOTO 6240
6360 IF B$="Q" THEN A$="Aborted":GOSUB 13020:RETURN
6380 IF B$="C" THEN 6180
6400 IF B$="E" THEN 6460
6420 IF B$="S" THEN 6560
6440 GOTO 6240
6460 GOSUB 13020:A1$="Line #?":GOSUB 13020:GOSUB 13260:L=VAL(B$)
6480 IF L=0 OR L>F THEN 6240 ELSE A$="Was:":GOSUB 13020:A$=A$(L):GOSUB 13020
6500 A1$="Enter new line":IF NOT XPR THEN A1$=A1$+" (C/R for no change)"
6520 A1$=A1$+":":GOSUB 13020:GOSUB 13260
6540 IF B$="" THEN 6240 ELSE A$(L)=B$+" ":GOTO 6240
6560 REM
6580 IF PW$<>"" THEN PW$=";"+PW$
6600 A$="Updating summary file, ":N=1:GOSUB 13020
6620 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
6640 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 16000:PUT#1,RE
6660 RE=RE+1:S$=D$:GOSUB 16000:PUT#1,RE
6680 RE=RE+1:S$=N$+" "+O$:GOSUB 16000:PUT#1,RE
6700 RE=RE+1:S$=T$:GOSUB 16000:PUT#1,RE
6720 RE=RE+1:S$=K$:GOSUB 16000:PUT#1,RE
6740 RE=RE+1:S$=STR$(F):GOSUB 16000:PUT#1,RE
6760 RE=RE+1:S$=" 9999":GOSUB 16000:PUT#1,RE
6780 CLOSE#1
6800 A$="next msg #, ":N=1:GOSUB 13020:

     OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
6820 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
6840 A$="active msg's, ":N=1:GOSUB 13020
6860 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
6880 A$="and msg file.":N=1:GOSUB 13020:OPEN "R",1,"A:MESSAGES",65:RL=65
6900 FIELD#1,65 AS RR$
6920 RE=MX+1
6940 S$=STR$(V+1)+PW$:GOSUB 16000:PUT#1,RE
6960 RE=RE+1:S$=D$:GOSUB 16000:PUT#1,RE
6980 RE=RE+1:S$=N$+" "+O$:GOSUB 16000:PUT#1,RE
7000 RE=RE+1:S$=T$:GOSUB 16000:PUT#1,RE
7020 RE=RE+1:S$=K$:GOSUB 16000:PUT#1,RE
7040 RE=RE+1:S$=STR$(F):GOSUB 16000:PUT#1,RE
7060 RE=RE+1
7080 FOR P=1 TO F:S$=A$(P):GOSUB 16000:PUT#1,RE:RE=RE+1:NEXT P:

     S$=" 9999":GOSUB 16000:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:

     M(MZ,1)=V+1:M(MZ,2)=F
7100 GOSUB 13020:GOSUB 13020:U=U+1:RETURN
8000 REM
8020 REM ***RETRIEVE MESSAGE***
8040 REM
8060 GOSUB 13020:A1$="MSG # ("+STR$(IU)+" -"+STR$(U)+" )":

     IF NOT XPR THEN A1$=A1$+" to retrieve (c/r to end)"
8080 A1$=A1$+"?":GOSUB 13020:GOSUB 13260:GOSUB 13020
8100 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
8120 IF M<1 THEN GOSUB 13020:RETURN
8140 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":GOTO 8060
8160 GOSUB 12220:GOSUB 13020
8180 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,63 AS RR$:MI=0
8200 MI=MI+1:IF (MI>MZ) OR BK THEN 8540 ELSE G=M(MI,1)
8220 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 8200
8240 IF G>M THEN 8480
8260 GOSUB 19100:IF OK THEN 8280 ELSE RE=RE+M(MI,2):GOTO 8200
8280 RE=RE+1:GET#1,RE:GOSUB 16500:D$=S$
8300 RE=RE+1:GET#1,RE:GOSUB 16500:NO$=S$
8320 RE=RE+1:GET#1,RE:GOSUB 16500:T$=S$
8340 RE=RE+1:GET#1,RE:GOSUB 16500:GOSUB 19200:K$=S$
8360 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 13020
8380 A$="Msg #"+STR$(G)+" was entered on date "+D$+" from "+NO$:GOSUB 13020
8400 A$="To "+T$+" about "+K$:GOSUB 13020:GOSUB 13020
8420 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 16500:A$=S$:GOSUB 13020
8440 IF BK THEN 8540
8460 RE=RE+1:NEXT P:GOSUB 13020
8480 IF RIGHT$(B$,1)<>"+" THEN CLOSE:GOTO 8020
8500 M=M+1:MI=0:RE=1
8520 IF M<=U AND NOT BK THEN 8200
8540 CLOSE:A$="End of msg's.":GOSUB 13020:GOSUB 13020:D$="":NO$="":RETURN
9000 REM
9020 REM ***SUMMARIZE MESSAGES***
9040 REM COMMON CODE FOR S AND Q CMDS
9060 REM
9080 GOSUB 13020:

      A1$="Msg # ("+STR$(IU)+" -"+STR$(U)+" ) to start (C/R to end)?":

      GOSUB 13020:C=1:GOSUB 13260:C=0:GOSUB 13020
9100 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$):GOSUB 13220
9120 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 9220
9140 IF LEN(B$)<3 THEN RETURN
9160 IF MID$(B$,2,1)<>"=" THEN RETURN
9180 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
9200 IF ST=0 THEN RETURN
9220 IF M<1 THEN RETURN
9240 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":RETURN
9260 IF NOT QU THEN GOSUB 12220:GOSUB 13020
9280 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD #1,28 AS RR$
9300 GET #1,RE
9320 IF EOF(1) OR BK THEN 9660 ELSE G=VAL(RR$)
9340 IF G>9998 THEN 9660
9360 IF G<M THEN RE=RE+6:GOTO 9300
9380 GOSUB 19100:IF OK THEN 9400 ELSE RE=RE+6:GOTO 9300
9400 GET #1,RE+ST+1:IF ST=0 THEN 9420 ELSE GOSUB 16500:IF INSTR(S$,SV$)=0 THEN RE=RE+6:GOTO 9300
9420 IF NOT QU THEN 9500
9440 REM quick summary
9460 GET #1,RE+4:GOSUB 16500:GOSUB 19200:

      A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+" "+S$:GOSUB 13020
9480 IF U=G OR BK THEN 9660 ELSE RE=RE+6:GOTO 9300
9500 REM full summary
9520 A$="Msg #"+STR$(G)+"    Date entered: ":N=1:GOSUB 13020:IF BK THEN 9660
9540 RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$+"   From: ":N=1:GOSUB 13020:IF BK THEN 9660
9560 RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
9580 A$="To: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
9600 A$="About: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:

      GOSUB 16500:GOSUB 19200:A$=S$:GOSUB 13020:IF BK THEN 9660
9620 A$="Size: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
9640 GOSUB 13020:IF U=G OR BK THEN 9660 ELSE RE=RE+1:GOTO 9300
9660 GOSUB 13020:A$="***** End of summary *****":GOSUB 13020:GOSUB 13020:GOSUB 13020:CLOSE:RETURN
10000 REM
10020 REM ***GOODBYE***
10040 REM
10060 GOSUB 13020:A1$="Want to leave any comments?":GOSUB 13020:C=1:GOSUB 13260:C=0
10080 IF LEFT$(B$,1)<>"Y" THEN 10260
10100 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$:GET#1,1:RE=VAL(RR$)+1:RL=65
10120 IF RE=1 THEN RE=2
10140 S$="From: "+N$+" "+O$:GOSUB 16000
10160 PUT#1,RE
10180 A$="Enter comments; to end, hit C/R.":GOSUB 13020
10200 A$="Ok>":N=1:GOSUB 13020:GOSUB 13260
10220 IF B$="" THEN 10240 ELSE RE=RE+1:S$=B$:RL=65:GOSUB 16000:PUT#1,RE:GOTO 10200
10240 S$=STR$(RE):RL=65:GOSUB 16000:PUT#1,1:CLOSE
10260 GOSUB 13020:

     A$="Character count:  "+STR$(A)+" typed by system - "+STR$(D)+

     " typed by you.":GOSUB 13020:

     A$="From Ron: thanks for calling, "+N$+".":GOSUB 13020
10280 A$="***** End of connection ******":GOSUB 13020:GOSUB 13020:SYSTEM
11000 REM
11020 REM ***KILL A MESSAGE***
11040 REM
11060 GOSUB 13020:A1$="Message # to kill?":GOSUB 13020:GOSUB 13260
11080 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
11100 IF M<1 THEN GOSUB 13020:RETURN
11120 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":GOTO 11040
11140 A$="Scanning summary file...":GOSUB 13020:

     OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
11160 GET#1,RE
11180 IF EOF(1) THEN 11520 ELSE G=VAL(RR$)
11200 IF G>9998 THEN 11520
11220 IF G<M THEN RE=RE+6:GOTO 11160
11240 IF G>M THEN 11520
11260 GOSUB 19100:IF NOT OK THEN 11520
11280 GOSUB 16500:PW=INSTR(S$,";"):PW$=""
11300 IF PW=0 OR N$+O$="SYSOP" OR PERS THEN PERS=0:GOTO 11340
11320 PW$=MID$(S$,PW+1):A1$="Password ?":GOSUB 13020:C=1:GOSUB 13260:C=0:

      IF B$<>PW$ THEN A$="Incorrect.":GOSUB 13020:GOSUB 13020:CLOSE:RETURN
11340 S$=" 0"+":"+STR$(G):GOSUB 16000:PUT#1,RE:CLOSE
11360 A$="Updating message file...":GOSUB 13020
11380 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
11400 MI=MI+1:IF MI>MZ THEN 11520 ELSE G=M(MI,1)
11420 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 11400
11440 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 16000:PUT#1,RE:M(MI,1)=0
11460 CLOSE#1:A$="Updating message count...":GOSUB 13020
11480 OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:

     GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS:CLOSE
11500 GOSUB 13020:A$="Message killed.":GOSUB 13020:GOSUB 13020:RETURN
11520 CLOSE:A$="Message not found.":GOSUB 13020:GOSUB 13020:RETURN
12000 REM
12020 REM ***DISPLAY USER FILE***
12040 REM
12060 GOSUB 12220:OPEN "R",1,"A:USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$:

      FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
12080 FOR I=NU+1 TO 2 STEP -1:

      GET#1,I:IF SU$<>"*" THEN GOSUB 16500:A$=S$:GOSUB 13020
12100 IF BK THEN 12140
12120 NEXT I
12140 CLOSE:GOSUB 13020:RETURN
12160 REM
12180 REM **** PRINT CONTROL-CHAR INFO
12200 REM
12220 GOSUB 13020
13000 A$="Use ctl-K to abort, ctl-S to pause."
13020 REM
13040 REM ***PRINT STRING FROM A$ ON CONSOLE***
13060 REM
13080 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
13100 IF A1$<>"" THEN A$=A1$:A1$=""
13120 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 13180
13140 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
13160 IF BI=11 THEN BK=-1:GOTO 13220 ELSE PRINT A$
13180 A=A+LEN(A$)
13200 IF N$+O$="SYSOP" AND INP(255)=1 THEN LPRINT A$;:

         IF N=0 AND RIGHT$(A$,1)<>"?" THEN LPRINT
13220 A$="":N=0
13240 RETURN
13260 REM
13280 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
13300 REM
13320 IF BEL AND SAV$="" THEN PRINT CHR$(7);
13340 B$="":BK=0
13360 IF SAV$="" THEN LINE INPUT SAV$
13380 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 13420
13400 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
13420 IF LEN(B$)=0 THEN RETURN
13440 IF C=0 THEN 13480
13460 FOR ZZ=1 TO LEN(B$):MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):NEXT ZZ
13480 IF LEN(B$)<62 THEN 13580
13500 A$="Input line too long - would be truncated to:":GOSUB 13020
13520 B$=LEFT$(B$,61):PRINT B$
13540 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
13560 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 13260
13580 D=D+LEN(B$):RETURN
13600 RETURN
13620 REM
15000 REM ***ON ERROR HANDLER***
15010 IF ERL=430 THEN RESUME 450
15020 IF ERL=18030 THEN RESUME 18050
15030 IF ERL=700 THEN RE=0:RESUME 710
15040 IF ERL=740 THEN M=0:RESUME 750
15050 IF ERL=760 THEN C=0:RESUME 770
15060 IF ERL=780 THEN U=0:RESUME 790
15070 IF ERL=6060 THEN V=0:RESUME 6080
15080 IF ERL=6800 THEN C=0:RESUME 6820
15090 IF ERL=6840 THEN C=0:RESUME 6860
15100 RESUME NEXT
16000 REM
16010 REM FILL AND STORE DISK RECORD
16020 REM
16030 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
16040 RETURN
16500 REM
16510 REM UNPACK DISK RECORD
16520 REM
16530 ZZ=LEN(RR$)-2
16540 WHILE MID$(RR$,ZZ,1)=" "
16550 ZZ=ZZ-1:IF ZZ=1 THEN 16570
16560 WEND
16570 S$=LEFT$(RR$,ZZ)
16580 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
16590 RETURN
17000 REM
17010 REM *** TOGGLE EXPERT USER MODE
17020 REM
17030 XPR=NOT XPR:RETURN
17040 REM
17050 REM *** TOGGLE BELL PROMPT
17060 REM
17070 BEL=NOT BEL:RETURN
18000 REM
18010 REM SUBROUTINE TO PRINT A FILE
18020 REM
18030 OPEN "I",1,"A:"+FIL$:BK=0
18040 IF EOF(1) OR BK THEN 18050 ELSE LINE INPUT #1,A$:GOSUB 13020:GOTO 18040
18050 CLOSE #1:RETURN
18060 REM FULL SUMMARY
18070 QU=0:GOSUB 9000:RETURN
18080 REM QUICK SUMMARY
18090 QU=-1:GOSUB 9000:RETURN
19000 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE CMD)
19010 GOSUB 13020
19020 IF N$+O$<>"SYSOP" THEN 1200' IF NOT SYSOP, SAY "I DON'T UNDERSTAND".
19030 OPEN "R",1,"A:CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
19040 CA=CN
19050 FOR CNT=SIZ+1 TO 2 STEP -1
19060 GET #1,CNT:GOSUB 16500:A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 13020:IF BK THEN 19090
19070 CA=CA-1
19080 NEXT CNT
19090 CLOSE:A$= "END OF CALLERS.":GOSUB 13020:GOSUB 13020:RETURN
19100 REM TEST FOR PERSONAL MESSAGES
19110 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")=0 THEN 19160
19120 PERS=-1
19130 IF N$+O$="SYSOP" THEN 19160
19140 GET #1,RE+3:GOSUB 19170:IF OK THEN 19160
19150 GET #1,RE+2:GOSUB 19170
19160 RETURN
19170 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
19180 IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN OK=-1 ELSE OK=0
19190 RETURN
19200 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
19210 RETURN
